home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / datebox.exe / DATEBOX.PAS < prev    next >
Pascal/Delphi Source File  |  1991-07-07  |  38KB  |  1,101 lines
  1. unit datebox;
  2. (*****************************
  3.     Most parts of this unit were imported from Borland libraries
  4.     (I'm R.Regez on GEnie and    100014,2516 on CompuServe) and adapted
  5.     to my needs: 90/7.7.91.
  6.  
  7.     Many thanks to Gerald Rohr (GENIE G.ROHR), who writes in his TPWIO.PAS:
  8.       "Much credit is due Bill Meacham who wrote the original file IO22.INC
  9.         and released it to the public domain.  Using that work this unit was
  10.         created and added to by Gerald Rohr of Homogenized Software.  As
  11.         with Bill's work, this program is released to the Public Domain for
  12.         all to use and modify."
  13.  
  14.     Same to Rick Amerson (uploaded to GENIE by R.WERT) whose TURBO CALENDAR FUNCTIONS
  15.     (Module version 1.01A; CALENDAR.PAS) inspired me to look around for the
  16.     "ultimate date unit"!
  17.  
  18.    Last to join was Charles B. Chapman (CompuServe 74370,516, whose DAYFEASTER has
  19.     been integrated, and whose Julian/Gregorian Routines seem to be the most
  20.     sophisticated, at least, I understand them least...
  21.     I have added JulianDay and JulianDaytoDate without integrating them.
  22.     Should I use them?
  23.  
  24.     Using Rick Amerson's ideas, I added COUNTDAYS which extracts dates from
  25.     INT's or LONGINT's which bear dates computed to a given baseyear (between
  26.     1901-2100).    I needed that to access a broad Swiss stock market database
  27.     where the dates    are "hidden" in INT's as differences to 1.1.1976 (without
  28.     taking notice    of leapyears! The functions to correct that are part of a
  29.     separate unit).    An illustration of this concept is in    FAR_DATE,
  30.     which returns    the n-days in the future or in the past (-) lying date,
  31.     relative to any date.
  32.  
  33.     A little bug in DAYOFWEEK (G.Rohr's ZELLER) has been corrected (?); the
  34.     function returned some negative numbers in the years outside 1925-1999.
  35.    An alternative by Charles B. Chapman has been added (as commentary), it
  36.    seems to return identical values. And old Julius would rotate in his grave
  37.     if he knew, that I'm calculating leapyears in "his" part of the calendar...
  38.  
  39.     Dear anglosaxons: Please don't use set types with text! If I try
  40.     to adapt your programs to German or French, the chars above ASCII 127
  41.     kill Turbo Pascal's compiler (syntax error 5)!
  42.     Examples: your set type    monthname=(January,February,March...)
  43.     translates to German as:  Monat_Name=(Januar,Februar,März..) (ASCII 132)
  44.                   to French as: nom_du_mois=(Janvier,Février...)    (ASCII 130)
  45.     You would not build set types with japanese chars, would you?
  46.  
  47.    Another problem is the format: Nobody here uses MM/DD/(CC)YY, just
  48.    DD/MM/(CC)YY is common. Does "go metrics" in USA and UK solve this?
  49.    At least, an USDATETEXT(), which calls DATETEXT() and cuts and pastes
  50.    the resulting date-string, should be possible. Or should one try to
  51.    link this format problem with the "language" switch?
  52.  
  53.     ....and, dear anglosaxons: you might find my use of your language
  54.     disturbing, please don't hesitate to inform me about the most terrible
  55.     mistakes...
  56.                                             Rudolf Regez, CH-8952 Schlieren,Switzerland.
  57.  
  58. *****************************)
  59. INTERFACE
  60. uses dos,crt,KEYBRD;
  61. { KEYBRD is my I/O-unit; just remove it's reference and the brackets
  62. below, and keytype, keysettype and key will work standalone}
  63. {
  64. type
  65. keytype =  (NullKey,CarriageReturn,TabKey,BackspaceKey,RightArrow,
  66.                 LeftArrow,DelKey,InsertKey,HomeKey,EndKey,TextKey,NumberKey,
  67.                 SpaceKey,EscapeKey);
  68. keySetType = set of keyType;
  69. var key:keytype;
  70. }
  71. var        baseyear:longint;                {range: 1901<=  baseyear  <=2100}
  72.             language:integer;
  73.             {0: english; german:1; french:2; italian:3}
  74.             sysdatetime:datetime;  {Never use sysdatetime directly in procedures
  75.                                          or functions, it could get changed!}
  76.             sysdate_str,sysdate10_str:string;
  77.             separator:char;
  78.             datekey:keytype;
  79.  
  80. FUNCTION    datetext(buf_dt:datetime;long:integer):string;
  81. {  returns a string of the dates to print, returns different date formats
  82.     dependent upon value of long and in the language set with the
  83.     global variable "language" (default: German, of course, set in the
  84.     initialization part of this unit)}
  85. {    values of long:                                     8 ->            02.09.91
  86.                                                             10 ->         02.09.1991
  87.     add 10 to eliminate leading zero's    18(20) ->            2.9.(19)91
  88.     add 100 to get 'Mon, (D)D.(M)M.(YY)YY' format
  89.     add 1000 to get 'Monday (D)D. September (YY)YY' format
  90.     add 10000 to get 'Monday (D)D. Sep. (YY)YY' format                                }
  91.  
  92. PROCEDURE read_date (var date_str:string;var dt:datetime;var key:keytype);
  93. {reads date from keyboard after last cursor position and tests it
  94.  if incoming date_str is not empty and if correct this serves als default}
  95.  
  96. FUNCTION check_date (var date_str:string):boolean;
  97. {tests a string-date}
  98.  
  99. FUNCTION longdat_from_dt(newdt:datetime):longint;
  100. {transforms datetime format into Longint CCYYMMDD ie 19911231}
  101.  
  102. PROCEDURE dt_from_longdat(newdt_long : longint;var new_dt:datetime);
  103. {G. Rohr's get_dt_val; transforms Longint CCYYMMDD ie 19911231 into
  104.  datetime format}
  105.  
  106. FUNCTION equal_date(dt1, dt2 : datetime) : boolean;         {Gerald Rohr}
  107. { Tests whether two dates are equal }
  108.  
  109. FUNCTION weekend(dt:datetime):boolean;                       {Rudolf Regez}
  110.  
  111. PROCEDURE dt_from_stringdat(var s:string;var dt:datetime);    {Rudolf Regez}
  112. { converts date-string into datetime-date}
  113.  
  114. FUNCTION date_diff(dt1, dt2 : datetime) : longint;          {Gerald Rohr}
  115. { computes the number of days between two dates }
  116.  
  117. PROCEDURE next_day(var dt : datetime);                             {Gerald Rohr}
  118. { Adds one day to the date }
  119.  
  120. PROCEDURE next_workingday(var dt : datetime);               {Rudolf Regez}
  121. { Seeks next working day }
  122.  
  123. PROCEDURE prev_day(var dt : datetime);                             {Gerald Rohr}
  124. { Subtracts one day from the date }
  125.  
  126. PROCEDURE prev_workingday(var dt : datetime);               {Rudolf Regez}
  127. { Seeks prev working day }
  128.  
  129. FUNCTION far_date(var dt:datetime;d:longint):string;            {Rudolf Regez}
  130. {..a more general next_/prev_day-routine}
  131.  
  132. PROCEDURE Today;                                                          {Rick Amerson}
  133. {puts system date & time (time when unit is initialized) in the global
  134. SYSDATETIME (DateTime) and returns the SYSDATE_STR-string}
  135.  
  136. FUNCTION countdays_into_dt (d:longint;var dt:datetime):string;          {Rudolf Regez}
  137. {converts d days from BASEYEAR, where: 1901<=BASEYEAR<=2100, in a
  138.  DATE10_STR; valid date range: 1.1.0004<=DATE<=???? (at least 5101!)
  139.  When DATE_DIFF is used to compute the days, add 1 day to include the starting
  140.  point: d:=DATE_DIFF(baseyear_date,DATE)+1 to get the same date DATE back
  141.  from DAYS_SINCE(d); BASEYEAR must be: 1.1.BASEYEAR,
  142.  where: 1901<=BASEYEAR<=2100; example in FAR_DATE. I need that
  143.  to read a compressed tw byte date from a large database which contains Swiss Stock Market prices}
  144.  
  145. FUNCTION count_days(dt:datetime):longint;                            {Rudolf Regez}
  146. {calculate number of days from 1.1.BASEYEAR; the result fed as "d" into
  147.  COUNTDAYS_INTO_DT should return same dt}
  148.  
  149. FUNCTION count_intdays(dt:datetime):integer;                            {Rudolf Regez}
  150. {calculate INTEGER number of days from 1.1.BASEYEAR; the result fed as "d" into
  151.  COUNTDAYS_INTO_DT should return same dt. LIMIT: 32767, of course! I need that
  152.  to write a compressed tw byte date to a large database which contains
  153.  Swiss Stock Market prices}
  154.  
  155. FUNCTION leapyear(yr:word):boolean;                                  {Gerald Rohr}
  156. { Whether the year is a leap year or not.
  157.   The year is year and century, e.g. year '1984' is 1984, not 84 }
  158.  
  159. PROCEDURE DateOfEaster (Yr : WORD; VAR Mo, Da : WORD);        {Charles B. Chapman}
  160.  
  161.  
  162. IMPLEMENTATION
  163. type
  164.         juldate = record
  165.             yr  : longint ; { 0 .. 9999 }
  166.             day : longint ; { 1 .. 366 }
  167.         end;
  168.         str10=string[10];
  169.         montharray = array [1 .. 13] of integer ;
  170.         monthnamedef=array[1..48] of str10;
  171.         daynamedef=array[0..27] of str10;
  172.  
  173. const
  174.         dayname:daynamedef           =('Sunday','Monday','Tuesday','Wednesday',
  175.                                             'Thursday','Friday','Saturday',
  176.                                             'Sonntag','Montag','Dienstag','Mittwoch',
  177.                                             'Donnerstag','Freitag','Samstag',
  178.                                             'Dimanche','Lundi','Mardi','Mercredi',
  179.                                             'Jeudi','Vendredi','Samedi',
  180.                                             'Domenica','Lunedi','Martedi','Mercoledi',
  181.                                             'Giovedi','Venerdi','Sabato');
  182.  
  183.         monthname:monthnamedef     = ('Jan